home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / PollingEnvModes-Shan.st < prev    next >
Text File  |  1993-07-24  |  5KB  |  192 lines
  1. ExpandedMode subclass: #PollingEnvMode
  2.     instanceVariableNames: ''
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'PollingEnvModes-Shan'!
  6.  
  7.  
  8. !PollingEnvMode methodsFor: 'controller access'!
  9.  
  10. defaultControllerClass
  11.     ^PollingEnvController1! !
  12.  
  13. !PollingEnvMode methodsFor: 'layering'!
  14.  
  15. computeSubLayeringBelow: aSubView withIn: aRect 
  16.     "My only subView is a polling view.  It doesn't have to compute the   
  17.     layering.  Shan April 23,1989"
  18.  
  19.     ^self! !
  20.  
  21. !PollingEnvMode methodsFor: 'initialize-release'!
  22.  
  23. initialize
  24.     "Set the borderwidth to 1."
  25.     "Shan April 8, 1989"
  26.  
  27.     super initialize.
  28.     self borderWidth: 1.
  29.     "Assign a color so that the layering algorithm comptes correctly."
  30.     self insideColor: Form white! !
  31.  
  32. !PollingEnvMode methodsFor: 'enter/leaveEvent-process'!
  33.  
  34. processEnter: enterEvent 
  35.     "The only subView I have is a polling View.  It doesn't process 
  36.     enterEvent. "
  37.     "Shan March 15, 1989"
  38.  
  39.     | topSubView |
  40.     visible ifFalse: [^false].
  41.     cursorIn _ true.
  42.     self controller processEvent: enterEvent!
  43.  
  44. processLeave: leaveEvent 
  45.     "The only subView I have is a polling View.  It doesn't process  
  46.     leaveEvent."
  47.     "Shan March 15, 1989"
  48.  
  49.     | topSubView |
  50.     cursorIn _ false.
  51.     visible ifFalse: [^false].
  52.     self controller processEvent: leaveEvent!
  53.  
  54. topSubModeEnteredFrom: offspring 
  55.     "The only subView I have is a polling View.  It doesn't count as a  
  56.     subMode.  Therefore, I don't really have a subMode.  Process as if  
  57.     subViews is nil."
  58.     "Shan Mrach 16, 1989"
  59.  
  60.     ^nil!
  61.  
  62. topSubModeLeft
  63.     "The only subView I have is a polling View.  It doesn't count as a 
  64.     subMode.  Therefore, I don't really have a subMode.  Process as if 
  65.     subViews is nil."
  66.     "Shan Mrach 16, 1989"
  67.  
  68.     ^nil! !
  69.  
  70. !PollingEnvMode methodsFor: 'event handling'!
  71.  
  72. processEvent: event 
  73.     (self interestedIn: event)
  74.         ifTrue: 
  75.             [event selector = #cursorMove ifTrue: [self processEnterLeave: event].
  76.             ^self controller processEvent: event]
  77.         ifFalse: [^false]! !
  78.  
  79. !PollingEnvMode methodsFor: 'displaying'!
  80.  
  81. displaySubViewsOn: aMedium in: aRect 
  82.     "I have only one subView which is a polling application.  It doesn't  
  83.     understand the message 'displayIn:'."
  84.     "Shan March 17, 1989"
  85.     "The View class doesn't know how to display on a medium other than 
  86.     Display.  This causes problems when we try to move image.  It will 
  87.     displayBorder on the screen instead of aMedium.  Temp fix is to skip 
  88.     the display message when aMedium is not Display.  Shan June 16, 
  89.     1989 "
  90.  
  91.     aMedium == Display ifFalse: [^self].
  92.     subViews do: [:aSubView | aSubView display]! !
  93.  
  94. !PollingEnvMode methodsFor: 'drag support'!
  95.  
  96. prepareForDrag: aSymbol
  97.     "Shan July 16, 1989"
  98.  
  99.     savedStates _ SaveState controller: self controller cursorIn: cursorIn.
  100.     model isNil
  101.         ifTrue: [self controller: OpaqueController1 new]
  102.         ifFalse: [self controller: (model dragControllerFor: aSymbol)].!
  103.  
  104. recoverFromDrag: aSymbol
  105.     "Set up the normal controller.  Shan July 16, 1989"
  106.  
  107.     self controller: savedStates controller.
  108.     cursorIn _ savedStates cursorIn.! !
  109.  
  110. !PollingEnvMode methodsFor: 'private'!
  111.  
  112. checkResize: w 
  113.     "Override to stop the resize constraint mechanism defined in Mode. 
  114.     Shan March 20, 1990"
  115.  
  116.     ^self!
  117.  
  118. clearCursorIn
  119.     "I have no subModes.  Shan July 28, 1989"
  120.  
  121.     cursorIn _ false! !
  122.  
  123. !PollingEnvMode methodsFor: 'subMode access'!
  124.  
  125. firstModeAt: p suchThat: aBlock cutOff: aCltnOfMode 
  126.     "Do not search the subviews. Shan April 24, 1990"
  127.  
  128.     (aCltnOfMode includes: self)
  129.         ifTrue: [^nil].
  130.     visible & (self displayBox containsPoint: p) ifFalse: [^nil].
  131.     (aBlock value: self)
  132.         ifTrue: ["Shan 25 May 1990"
  133.             ^self]
  134.         ifFalse: [^nil]! !
  135.  
  136. OpaqueController1 subclass: #PollingEnvController1
  137.     instanceVariableNames: ''
  138.     classVariableNames: 'PollingEnvController1ERD '
  139.     poolDictionaries: ''
  140.     category: 'PollingEnvModes-Shan'!
  141.  
  142.  
  143. !PollingEnvController1 methodsFor: 'private'!
  144.  
  145. runPolling
  146.     "Shan 16 May 1990"
  147.  
  148.     self eventQueue disable.
  149.     mode firstSubView controller startUp.
  150.     self eventQueue enable! !
  151.  
  152. !PollingEnvController1 methodsFor: 'Event Handling'!
  153.  
  154. enterMode
  155.     "This is a special case. The code is directly put here. Shan May 24, 
  156.     1989"
  157.  
  158.     mode superView firstSubView ~= mode ifFalse: [mode toFront].
  159.     mode obscuringRects isEmpty ifTrue: ["Shan 15 May 1990"
  160.         self runPolling].
  161.     ^true!
  162.  
  163. leftButtonDown
  164.     "Shan 16 May 1990"
  165.  
  166.     | spMode |
  167.     spMode _ mode.
  168.     [mode obscuringRects isEmpty]
  169.         whileFalse: 
  170.             [spMode obscuringRects isEmpty ifFalse: [spMode toFront].
  171.             spMode _ spMode superMode].
  172.     self runPolling.
  173.     ^true! !
  174. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  175.  
  176. PollingEnvController1 class
  177.     instanceVariableNames: ''!
  178.  
  179.  
  180. !PollingEnvController1 class methodsFor: 'access'!
  181.  
  182. eventResponsesDict
  183.     ^PollingEnvController1ERD! !
  184.  
  185. !PollingEnvController1 class methodsFor: 'initialize'!
  186.  
  187. ERDinit
  188.  
  189.     PollingEnvController1ERD _ super eventResponsesDict deepCopy.
  190.     PollingEnvController1ERD at: #enterMode put: #self.
  191.     "Use leftButton to bring self to front.  Shan 16 May 1990"
  192.     PollingEnvController1ERD at: #leftButtonDown put: #self! !